home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Input 64
/
Input_64_86-05_1986_Verlag_Heinz_Weise_de.d64
/
arrays .lsp
next >
Wrap
Text File
|
2023-02-26
|
2KB
|
47 lines
(array fexpr (nlambda l (putprop (car
l) (quote array) (dim (mapcar (quote
eval) (cddr l)) (eval (cadr l)))) (
car l)))
(lod fexpr (nlambda l (lod1 (getprop (
car l) (quote array)) (mapcar (quote
eval) (cdr l)))))
(sto fexpr (nlambda l (sto1 (getprop (
car l) (quote array)) (eval (cadr l))
(mapcar (quote eval) (cddr l)))))
(dim expr (lambda (nlis e) (cond ((
atom nlis) (copy e)) (t (build (car
nlis) (dim (cdr nlis) e))))))
(build expr (lambda (n e) (cond ((
zerop n) nil) (t (cons (copy e) (
build (sub1 n) e))))))
(sto1 expr (lambda (l e dims) (cond ((
atom dims) nil) ((atom (cdr dims)) (
rplaca (nth l (car dims)) e)) (t (
sto1 (car (nth l (car dims))) e (cdr
dims))))))
(lod1 expr (lambda (l dims) (cond ((
atom dims) l) (t (lod1 (car (nth l (
car dims))) (cdr dims))))))
(for fexpr (nlambda l (prog (var fst
lst exprs test-fn count-fn) (setq var
(car l)) (setq fst (eval (cadr l))) (
setq lst (eval (car (cddr l)))) (cond
((lessp lst fst) (setq test-fn (quote
lessp)) (setq count-fn (quote sub1)))
(t (setq test-fn (quote greaterp)) (
setq count-fn (quote add1)))) (setq
exprs (cdr (cddr l))) loop (cond ((
test-fn fst lst) (return nil))) (set
var fst) (mapc (quote eval) exprs) (
setq fst (count-fn fst)) (go loop))))
(while fexpr (nlambda l (prog (con
exprs) (setq con (car l)) (setq exprs
(cdr l)) loop (cond ((eval con) (mapc
(quote eval) exprs) (go loop))))))
(if fexpr (nlambda l (cond ((eval (
car l)) (eval (cadr l))) (t (last (
mapcar (quote eval) (cddr l)))))))
(arrfns value (array lod sto dim
build sto1 lod1 for while if arrfns))
nil